Monster Media 1996 #14/Monster Media No. 14 (April 1996) (Monster Media, Inc.).ISO/prog_bas/vbwarn.zip/FRMOFF.FRM

Text File | 1995-12-11 | 13KB | 446 lines

VERSION 2.00
Begin Form frmOff
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Officers"
   ClientHeight    =   2145
   ClientLeft      =   930
   ClientTop       =   2385
   ClientWidth     =   7695
   Height          =   2835
   Left            =   870
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2145
   ScaleWidth      =   7695
   Top             =   1755
   Width           =   7815
   Begin CommandButton cmdReturn
      Caption         =   "Return to Warning"
      Height          =   315
      Left            =   5700
      TabIndex        =   10
      Top             =   900
      Width           =   1815
   End
   Begin SSFrame Frame3D1
      ForeColor       =   &H00000000&
      Height          =   915
      Left            =   120
      ShadowColor     =   1  'Black
      TabIndex        =   13
      Top             =   1200
      Width           =   7455
      Begin Data dtaOff
         BackColor       =   &H00C0C0C0&
         Caption         =   "Officers"
         Connect         =   ""
         DatabaseName    =   "vbwarn.mdb"
         Exclusive       =   0   'False
         Height          =   315
         Left            =   60
         Options         =   0
         ReadOnly        =   0   'False
         RecordSource    =   "Officer"
         Top             =   540
         Width           =   2955
      End
      Begin CommandButton cmdDel
         BackColor       =   &H00C0C0C0&
         Caption         =   "&Delete"
         Height          =   315
         Left            =   4260
         TabIndex        =   6
         Top             =   540
         Width           =   915
      End
      Begin CommandButton cmdSave
         BackColor       =   &H00C0C0C0&
         Caption         =   "&Save"
         Height          =   315
         Left            =   5340
         TabIndex        =   3
         Top             =   540
         Width           =   915
      End
      Begin CommandButton cmdNew
         BackColor       =   &H00C0C0C0&
         Caption         =   "&New"
         Height          =   315
         Left            =   3180
         TabIndex        =   5
         Top             =   540
         Width           =   915
      End
      Begin CommandButton cmdCancel
         BackColor       =   &H00004080&
         Caption         =   "&Cancel"
         Height          =   315
         Left            =   6420
         TabIndex        =   4
         Top             =   540
         Width           =   915
      End
      Begin TextBox txtJumpTo
         BackColor       =   &H00C0C0C0&
         Height          =   285
         Left            =   4260
         TabIndex        =   8
         Top             =   180
         Width           =   3075
      End
      Begin CommandButton cmdJumpTo
         Caption         =   "Jump To:"
         Height          =   315
         Left            =   3180
         TabIndex        =   9
         Top             =   180
         Width           =   975
      End
      Begin ComboBox cmbSortBy
         BackColor       =   &H00C0C0C0&
         Height          =   300
         Left            =   780
         TabIndex        =   7
         Top             =   180
         Width           =   2235
      End
      Begin Label lblSortBy
         BackColor       =   &H00C0C0C0&
         Caption         =   "Sort By:"
         Height          =   195
         Left            =   60
         TabIndex        =   12
         Top             =   240
         Width           =   855
      End
   End
   Begin TextBox txtName
      BackColor       =   &H00C0C0C0&
      DataField       =   "Name"
      DataSource      =   "dtaOff"
      Height          =   285
      Left            =   2640
      TabIndex        =   2
      Top             =   540
      Width           =   2835
   End
   Begin TextBox txtOffID
      BackColor       =   &H00C0C0C0&
      DataField       =   "OffID"
      DataSource      =   "dtaOff"
      Height          =   285
      Left            =   2640
      TabIndex        =   1
      Top             =   180
      Width           =   1695
   End
   Begin Label Label3
      BackColor       =   &H00C0C0C0&
      Caption         =   "Officers"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   13.5
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   315
      Left            =   120
      TabIndex        =   14
      Top             =   60
      Width           =   1095
   End
   Begin Label Label2
      BackColor       =   &H00C0C0C0&
      Caption         =   "Name:"
      Height          =   195
      Left            =   1980
      TabIndex        =   11
      Top             =   540
      Width           =   615
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Officer ID:"
      Height          =   195
      Index           =   0
      Left            =   1680
      TabIndex        =   0
      Top             =   180
      Width           =   975
   End
   Begin Menu mnuRecord
      Caption         =   "&Record"
      Begin Menu mnuNew
         Caption         =   "&New"
      End
      Begin Menu mnuDel
         Caption         =   "&Delete"
      End
      Begin Menu mnuSave
         Caption         =   "&Save"
      End
      Begin Menu mnuCancel
         Caption         =   "&Cancel"
      End
      Begin Menu Dash
         Caption         =   "-"
      End
      Begin Menu mnuExit
         Caption         =   "E&xit"
      End
   End
   Begin Menu mnuHelp
      Caption         =   "&Help"
   End
End
Option Explicit
Dim CurrRec As String
Dim Starting As Integer
Dim LastNum As String
Dim PSort As Integer

Sub cmbSortBy_Click ()
    Dim Src As String
    If cmbSortBy.Text = "Officer ID" Then Src = QOff & "ORDER BY OffID"
    If cmbSortBy.Text = "Officer Name" Then Src = QOff & "ORDER BY Name"
    dtaOff.RecordSource = Src
    dtaOff.Refresh
End Sub

Sub cmdCancel_Click ()
    If LastNum <> "" Then
        dtaOff.Recordset.FindFirst "OffID = " & "'" & LastNum & "'"
        Call NoChange
    Else
        cmdNew.Value = True
    End If
End Sub

Sub cmdDel_Click ()
    On Error GoTo CheckRefInt
    dtaOff.Recordset.Delete
    dtaOff.Refresh
    If dtaOff.Recordset.EOF Then cmdNew.Value = True
    Exit Sub
CheckRefInt:
    If Err = 3200 Then
        MsgBox "Officer is on at least one ticket, cannot delete", MB_EXCL, "Warning Ticket"
        Exit Sub
    Else
        MsgBox "Unexpected Error " & "'" & Err & "'", MB_EXCL, "Warning Ticket"
        Exit Sub
    End If
    Resume
End Sub

Sub cmdJumpTo_Click ()
    CurrRec = dtaOff.Recordset!OffID
    If cmbSortBy.Text = "Officer ID" Then dtaOff.Recordset.FindFirst "OffID >= " & "'" & txtJumpTo & "'"
    If cmbSortBy.Text = "Officer Name" Then dtaOff.Recordset.FindFirst "Name >= " & "'" & txtJumpTo & "'"
    If dtaOff.Recordset.NoMatch Then
        MsgBox "No records found that match that value.", MB_EXCL, "Warning Ticket"
        dtaOff.Refresh
        dtaOff.Recordset.FindFirst "OffID = '" & CurrRec & "'"
    End If
End Sub

Sub cmdNew_Click ()
    Call Editing
    dtaOff.Recordset.AddNew
    txtOffID.SetFocus
End Sub

Sub cmdReturn_Click ()
    Unload frmOff
End Sub

Sub cmdSave_Click ()
  On Error GoTo CheckLenErr
  If txtOffID <> "" And txtName <> "" Then
    If MsgBox("Commit Changes?", MSGBOX_TYPE) = YES Then
        If dtaOff.EditMode = EM_ADDNEW Then
            dtaOff.Recordset.Update
            dtaOff.Recordset.MoveLast
            CurrRec = dtaOff.Recordset!OffID
            dtaOff.Refresh
            dtaOff.Recordset.FindFirst "OffID = " & "'" & CurrRec & "'"
        Else
            dtaOff.Recordset.Update
            CurrRec = dtaOff.Recordset!OffID
            dtaOff.Refresh
            dtaOff.Recordset.FindFirst "OffID =" & "'" & CurrRec & "'"
        End If
        Call NoChange
    End If
  Else
    MsgBox "Must have ID and last name to save", MB_EXCL, "Warning Ticket"
  End If
  Exit Sub
CheckLenErr:
    Select Case Err
        Case 3163
            MsgBox "A value is too long, fix or cancel save", MB_EXCL, "Warning Ticket"
            Exit Sub
        Case 3164
            MsgBox "This record has been deleted by another user", MB_EXCL, "Warning Ticket"
            dtaOff.Refresh
            If dtaOff.Recordset.EOF Then
                MsgBox "There are no records entered, you may add one now.", MB_EXCL, "Warning Ticket"
                cmdNew.Value = True
            Else
                Call NoChange
            End If
            Exit Sub
        Case 3200
            MsgBox "Can't change the ID because there is already a ticket for this officer.", MB_EXCL, "Warning Ticket"
            txtOffID = dtaOff.Recordset!OffID
        Case Else
            MsgBox "Unexpected Error " & Str(Err) & " " & Error, MB_EXCL, "Warning Ticket"
            Exit Sub
    End Select
    Resume
End Sub

Sub dtaOff_Reposition ()
    If ((Not Starting) And (dtaOff.EditMode <> EM_ADDNEW)) Then
        If (Not dtaOff.Recordset.EOF) Then
            LastNum = dtaOff.Recordset!OffID
        Else
            LastNum = ""
        End If
    End If
End Sub

Sub dtaOff_Validate (Action As Integer, Save As Integer)
    Select Case Action
        Case 1 ' First
        Case 2 ' Previous
        Case 3 ' Next
        Case 4 ' Last
        Case 5 ' AddNew
        Save = False
        Case 6 ' Update
        Case 7 ' Delete
        If MsgBox("Delete Record?", MSGBOX_TYPE) <> YES Then Action = 0
        Case 8 ' Find
        Save = False
        Case 9 ' Set Bookmark
        Case 10 ' Close
        Case 11 ' Unload Form
        If (dtaOff.Enabled = False) Then
            If MsgBox("Commit Changes?", MSGBOX_TYPE) = YES Then
                If Not (txtOffID <> "" And txtName <> "") Then
                    MsgBox "Must have ID and last name to save", MB_EXCL, "Warning Ticket"
                    Action = 0
                End If
            Else
                Save = False
            End If
        End If
    End Select
End Sub

Sub Editing ()
    If dtaOff.Enabled = True Then
        dtaOff.Enabled = False
        mnuSave.Enabled = True
        mnuCancel.Enabled = True
        mnuNew.Enabled = False
        mnuDel.Enabled = False
        cmbSortBy.Enabled = False
        cmdJumpTo.Enabled = False
        cmdSave.Enabled = True
        cmdCancel.Enabled = True
        cmdNew.Enabled = False
        cmdDel.Enabled = False
        lblSortBy.ForeColor = &H808080
    End If
End Sub

Sub Form_Activate ()
    If Starting Then
        Call RedoCombo
        Starting = False
        dtaOff.Caption = "Officers by ID"
        cmbSortBy.Text = "Officer ID"
        dtaOff.Refresh
        If dtaOff.Recordset.EOF Then
            cmdNew.Value = True
        Else
            Call NoChange
        End If
    End If
End Sub

Sub Form_Load ()
    NL = (Chr(13) + Chr(10))
    Starting = True
End Sub

Sub mnuCancel_Click ()
    cmdCancel.Value = True
End Sub

Sub mnuDel_Click ()
    cmdDel.Value = True
End Sub

Sub mnuExit_Click ()
    Unload frmOff
End Sub

Sub mnuNew_Click ()
    cmdNew.Value = True
End Sub

Sub mnuSave_Click ()
    cmdSave.Value = True
End Sub

Sub NoChange ()
        lblSortBy.ForeColor = &H80000008
        dtaOff.Enabled = True
        mnuSave.Enabled = False
        mnuCancel.Enabled = False
        mnuNew.Enabled = True
        mnuDel.Enabled = True
        cmbSortBy.Enabled = True
        cmdJumpTo.Enabled = True
        cmdSave.Enabled = False
        cmdCancel.Enabled = False
        cmdNew.Enabled = True
        cmdDel.Enabled = True
End Sub

Sub RedoCombo ()
    cmbSortBy.AddItem "Officer ID"
    cmbSortBy.AddItem "Officer Name"
End Sub

Sub txtName_KeyPress (KeyAscii As Integer)
    Call Editing
End Sub

Sub txtOffID_KeyPress (KeyAscii As Integer)
    Call Editing
End Sub

Sub txtOffID_LostFocus ()
  If txtOffID.Text <> LastNum Then
    Dim DBClone As Dynaset
    Set DBClone = dtaOff.Recordset.Clone()
    DBClone.FindFirst "OffID = '" & txtOffID & "'"
    If Not DBClone.NoMatch Then
        If MsgBox("Display officer and lose any changes?", MSGBOX_TYPE) = YES Then
            dtaOff.Recordset.FindFirst "OffID = '" & txtOffID & "'"
            Call NoChange
        Else
            txtOffID = dtaOff.Recordset!OffID
        End If
    End If
  End If
End Sub